#!/usr/local/bin/perl
# Yen-Ming Lee <leeym@leeym.com>

use Fuse;
use Net::Amazon::S3;
use FindBin qw($Script);
use Sys::Syslog;
use POSIX;
use Digest::MD5 qw(md5_hex);
use Encode qw(from_to);
use Fcntl ':mode';
use Config::IniFiles;
use Cwd 'abs_path';
use Getopt::Long;
use strict;

my $reset = 0;
my $s3cfg = $ENV{'HOME'} . "/.s3cfg";
my $access_key;
my $secret_key;

openlog($Script, "pid", "notice");

my @OPT;
GetOptions("o=s" => \@OPT);
foreach my $opt (@OPT)
{
  if ($opt =~ m{^access_key=(.+)$})
  {
    $access_key = $1;
  }
  elsif ($opt =~ m{^secret_key=(.+)$})
  {
    $secret_key = $1;
  }
}

# s3cmd compatible configuration file
# http://s3tools.logix.cz/s3cmd
my %cfg;
tie %cfg, 'Config::IniFiles';
if (-s $s3cfg)
{
  tied(%cfg)->SetFileName($s3cfg);
  tied(%cfg)->ReadConfig || die @Config::IniFiles::errors;
}
if (!$access_key || !$secret_key)
{
  $access_key = $cfg{'default'}{'access_key'};
  $secret_key = $cfg{'default'}{'secret_key'};
}

while (!$access_key || !$secret_key)
{
  $reset = 1;
  print "Print input your access key: ";
  chomp($access_key = <STDIN>);
  print "Print input your secret key: ";
  chomp($secret_key = <STDIN>);
}

if ($reset)
{
  $cfg{'default'}{'access_key'} = $access_key;
  $cfg{'default'}{'secret_key'} = $secret_key;
  tied(%cfg)->WriteConfig($s3cfg) || die $!;
}

my $s3 = Net::Amazon::S3->new(
  {
    'aws_access_key_id'     => $access_key,
    'aws_secret_access_key' => $secret_key
  }
);

my $bucketname = shift;
my $mountpoint = abs_path(shift);

die "Usage: $Script bucketname mountpoint\n" if !$bucketname || !-d $mountpoint;
my @S = stat($mountpoint);

my $cache = $ENV{'HOME'} . "/.jdfs";
mkdir($cache) if !-d $cache;
die "$Script: can't mkdir $cache\n" if !-d $cache;

my $uid = $<;
my $gid = (getpwuid($<))[3];
$bucketname = sprintf("%s-%s", _md5($access_key), $bucketname);

my $bucket;
foreach my $_bucket (@{ $s3->buckets->{'buckets'} })
{
  next if ($_bucket->{'bucket'} ne $bucketname);
  $bucket = $_bucket;
  last;
}
if (!$bucket)
{
  syslog("notice", "bucket not found, create $bucketname");
  $bucket = $s3->add_bucket({ bucket => $bucketname }) or die $s3->errstr;
}

# fork into background
exit if fork;

Fuse::main(
  'debug'      => 0,
  'mountpoint' => $mountpoint,
  'mountopts'  => '',
  'threaded'   => 0,                      # not tested under threaded perl
  'getattr'    => "main::jd1_getattr",
  'readlink'   => "main::jd1_readlink",
  'getdir'     => "main::jd1_getdir",
  'mknod'      => "main::jd1_mknod",
  'mkdir'      => "main::jd1_mkdir",
  'unlink'     => "main::jd1_unlink",
  'rmdir'      => "main::jd1_rmdir",
  'symlink'    => "main::jd1_symlink",
  'link'       => "main::jd1_link",       # do not support hardlink (yet)
  'chmod'      => "main::jd1_chmod",
  'chown'      => "main::jd1_chown",      # owner is the one run $Script
  'truncate'   => "main::jd1_truncate",
  'utime'      => "main::jd1_utime",
  'open'       => "main::jd1_open",
  'read'       => "main::jd1_read",
  'write'      => "main::jd1_write",
  'statfs'     => "main::jd1_statfs",
  'release'    => "main::jd1_release",
  'fsync'      => "main::jd1_fsync",
  'rename'     => "main::jd1_rename",     # rename is in fact clone-and-delete
);

sub jd1_getattr
{
  my $path = shift;
  return _getattr($path);
}

sub _getattr
{
  my $path = shift;
  return @S if $path eq '/';
  my $depth  = _depth($path);
  my $remote = _remote($path);
  my $prefix = sprintf("%d%s.", $depth, $remote);
  my $type;
  my $attr;
  my $size;
  my $key_name;
  my $key_attr;
  my %ATTR;
  my $keys = $bucket->list({ 'prefix' => $prefix })->{'keys'};

  foreach my $key (@$keys)
  {
    if ($prefix ne substr($key->{'key'}, 0, length($prefix)))
    {
      syslog("notice", "_getattr: unknown key: " . $key->{'key'});
      next;
    }
    my $misc = substr($key->{'key'}, length($prefix));
    if ($misc =~ m{\w+\.(.*)\.attr$})
    {
      $attr     = $1;
      $key_attr = $key->{'key'};
    }
    else
    {
      $type     = $misc;
      $size     = $key->{'size'};
      $size     = 512 if $type eq 'dir';
      $key_name = $key->{'key'};
    }
  }
  if (!$key_name)
  {
    if ($key_attr)
    {
      syslog("notice", "_getattr: auto-purge: $key_attr");
      $bucket->delete_key($key_attr);
    }
    return -ENOENT();
  }
  my $mode = ($type eq 'file' ? 0644 : 0755);
  if (!$key_attr)
  {
    %ATTR = (
      'mtime' => time(),
      'ctime' => time(),
      'wattr' => 0,
      'mode'  => $mode,
    );
    $key_attr = sprintf("%s.%s.attr", $key_name, join("_00", %ATTR));
    syslog("notice", "_getattr: auto-recovery: $key_name");
    $bucket->add_key($key_attr, "", { 'Content-Length' => 0 });
  }
  else
  {
    $attr =~ s{_00}{\001}g;
    %ATTR = split(/\001/, $attr);
  }
  $mode = $ATTR{'mode'} if $ATTR{'mode'};
  $mode = ($mode | S_IFREG) if ($type eq 'file');
  $mode = ($mode | S_IFDIR) if ($type eq 'dir');
  $mode = ($mode | S_IFLNK) if ($type eq 'symlink');
  return (83, 1, $mode, 1, $uid, $gid, 1, $size, $ATTR{'mtime'}, $ATTR{'mtime'},
    $ATTR{'ctime'}, 4096, $size ? 4 : 0);
}

sub jd1_readlink
{
  my $path   = shift;
  my $depth  = _depth($path);
  my $remote = _remote($path);
  my $source = $bucket->get_key("$depth$remote.symlink");
  return _local($source->{'value'});
}

sub jd1_getdir
{
  my $path = shift;
  return _getdir($path);
}

sub _getdir
{
  my $path   = shift;
  my $depth  = _depth($path);
  my $remote = _remote($path);
  my $prefix = sprintf("%d%s", $depth + 1, $remote);
  my %K;
  foreach my $key (@{ $bucket->list({ 'prefix' => $prefix })->{'keys'} })
  {
    my $local = _local($key->{'key'});
    $local =~ s{.*/}{};
    $K{$local} = 1;
  }
  my @E = ('.', keys %K, 0);
  return @E;
}

sub jd1_mknod
{
  my $path = shift;
  my $mode = shift;
  my $dev  = shift;
  return _mknod($path, "file");
}

sub jd1_mkdir
{
  my $path = shift;
  my $mode = shift;
  return _mknod($path, "dir");
}

sub _mknod
{
  my $path     = shift;
  my $type     = shift;
  my $depth    = _depth($path);
  my $remote   = _remote($path);
  my $prefix   = sprintf("%d%s", $depth, $remote);
  my $key_name = "$prefix.$type";
  my $mode     = ($type eq 'file' ? 0644 : 0755);
  my %ATTR     = (
    'mtime' => time(),
    'ctime' => time(),
    'wattr' => 0,
    'mode'  => $mode,
  );
  my $key_attr = sprintf("%s.%s.attr", $key_name, join("_00", %ATTR));
  $bucket->add_key($key_name, "", { 'Content-Length' => 0 });
  $bucket->add_key($key_attr, "", { 'Content-Length' => 0 });
  return 0;
}

sub jd1_unlink
{
  my $path = shift;
  return _unlink($path);
}

sub jd1_rmdir
{
  my $path   = shift;
  my @getdir = _getdir($path);
  return -ENOTEMPTY() if scalar(@getdir) > 2;
  return -EDOOFUS()   if scalar(@getdir) < 2;    # '.' and 0
  return _unlink($path);
}

sub _unlink
{
  my $path   = shift;
  my $depth  = _depth($path);
  my $remote = _remote($path);
  my $prefix = sprintf("%d%s.", $depth, $remote);
  my $keys   = $bucket->list({ 'prefix' => $prefix })->{'keys'};
  return -EDOOFUS() if (scalar(@$keys) != 2);
  foreach my $key (@$keys)
  {
    $bucket->delete_key($key->{'key'});
  }
  return 0;
}

sub jd1_symlink
{
  my $path = shift;
  my $dest = shift;
  $path = "/" . $path if $path !~ m{^/};
  my $source   = sprintf("%d%s",         _depth($path), _remote($path));
  my $key_name = sprintf("%d%s.symlink", _depth($dest), _remote($dest));
  my %ATTR     = (
    'mtime' => time(),
    'ctime' => time(),
    'wattr' => 0,
    'mode'  => 0755,
  );
  my $key_attr = sprintf("%s.%s.attr", $key_name, join("_00", %ATTR));
  $bucket->add_key($key_name, $source);
  $bucket->add_key($key_attr, "", { 'Content-Length' => 0 });
  return 0;
}

sub jd1_rename
{
  my $old = shift;
  my $new = shift;
  return _rename($old, $new);
}

sub _rename
{
  my $old  = shift;
  my $new  = shift;
  my @stat = _getattr($old);
  if (S_ISDIR($stat[2]))
  {
    my @E = _getdir($old);
    _mknod($new, "dir");
    foreach my $e (@E)
    {
      next if ($e eq '.' or $e eq '0');
      _rename("$old/$e", "$new/$e");
    }
    _unlink($old);
  }
  else
  {
    _mknod($new, 'file');
    _write($new, _read($old));
    _fsync($new, 1);
    _unlink($old);
  }
  return 0;
}

sub jd1_link
{
  return -EOPNOTSUPP();
}

sub jd1_chmod
{
  my $path = shift;
  my $mode = shift;
  return _attr($path, { 'mode' => $mode });
}

sub jd1_chown
{
  return -EOPNOTSUPP();
}

sub jd1_truncate
{
  my $path   = shift;
  my $offset = shift;
  _write($path, substr(_read($path), 0, $offset));
  _fsync($path, 1);
  return 0;
}

sub jd1_utime
{
  my $path  = shift;
  my $ctime = shift;
  my $mtime = shift;
  return _attr($path, { 'ctime' => $ctime, 'mtime' => $mtime });
}

sub _attr
{
  my $path   = shift;
  my $attr   = shift;
  my %_ATTR  = %$attr;
  my $depth  = _depth($path);
  my $remote = _remote($path);
  my $prefix = sprintf("%d%s.", $depth, $remote);
  my $keys   = $bucket->list({ 'prefix' => $prefix })->{'keys'};

  return -EDOOFUS() if (scalar(@$keys) > 2);
  my $key_name;
  my %ATTR;
  foreach my $key (@$keys)
  {
    if ($key->{'key'} !~ m{\.attr$})
    {
      $key_name = $key->{'key'};
    }
    else
    {
      my $key_attr = $key->{'key'};
      my $attr = $1 if $key_attr =~ m{.*\.(?:file|dir|symlink)\.(.*)\.attr$};
      $attr =~ s{_00}{\001}g;
      %ATTR = split(/\001/, $attr);
      $bucket->delete_key($key->{'key'});
    }
  }
  foreach my $key (keys %_ATTR)
  {
    $ATTR{$key} = $_ATTR{$key};
  }
  my $key_attr = sprintf("%s.%s.attr", $key_name, join("_00", %ATTR));
  $bucket->add_key($key_attr, "", { 'Content-Length' => 0 });
  return 0;
}

sub jd1_open
{
  my $path   = shift;
  my $flag   = shift;
  my $depth  = _depth($path);
  my $remote = _remote($path);
  return 0;
}

sub jd1_read
{
  my $path   = shift;
  my $size   = shift;
  my $offset = shift;
  return substr(_read($path), $offset, $size);
}

sub _read
{
  my $path   = shift;
  my $depth  = _depth($path);
  my $remote = _remote($path);
  my $key    = $bucket->get_key("$depth$remote.file");
  return _decrypt($key);
}

sub jd1_write
{
  my $path   = shift;
  my $buffer = shift;
  my $offset = shift;
  my $length = length($buffer);
  return _write($path, $buffer, $offset);
}

sub _write
{
  my $path   = shift;
  my $buffer = shift;
  my $offset = shift || 0;
  my $length = length($buffer);
  my $depth  = _depth($path);
  my $remote = _remote($path);
  my $prefix = sprintf("%d%s", $depth, $remote);
  my $local  = "$cache/$prefix.file";
  my $fd;
  sysopen($fd, $local, O_WRONLY | O_CREAT) || return 0;
  sysseek($fd, $offset, SEEK_SET) || return 0;
  syswrite($fd, $buffer, $length) || return 0;
  close($fd) || return 0;
  return $length;
}

sub jd1_statfs
{
  return 0;

  #return ($pathlen, $files, $files_free, $blocks, $blocks_avail, $blocksize);
}

sub jd1_release
{
  my $path = shift;
  my $flag = shift;
  return _fsync($path, $flag);
}

sub jd1_fsync
{
  my $path = shift;
  my $flag = shift;
  return _fsync($path, $flag);
}

sub _fsync
{
  my $path   = shift;
  my $flag   = shift;
  my $depth  = _depth($path);
  my $remote = _remote($path);
  return 0 if !$flag;
  my $prefix = sprintf("%d%s", $depth, $remote);
  my $local = "$cache/$prefix.file";
  return 0 if !-f $local;
  die if $bucket->add_key_filename("$prefix.file", $local) == 0;
  unlink($local);
  return 0;
}

sub _md5
{
  my $src    = shift;
  my $digest = md5_hex($src);
  my $dst;
  while ($digest =~ m{^(..)})
  {
    my $str = $1;
    $digest = $';
    $str =~ s/^0//;
    $dst .= $str;
  }
  return $dst;
}

sub _depth
{
  my $path = shift;
  my $depth = ($path =~ s,/,/,g) - 1;
  $depth++ if $path =~ m{/[^/]+$};
  return $depth;
}

sub _remote
{
  my $src = shift;
  my $dst;
  foreach my $c (split(//, $src))
  {
    my $d = ord($c);
    if ($c eq '.')
    {
      $dst .= "_-";
    }
    elsif ($c eq '/')
    {
      $dst .= ".";
    }
    elsif ($c eq '_')
    {
      $dst .= "__";
    }
    elsif ($d < 32
      || ($d >= 58 && $d <= 64)
      || $d > 126
      || $c eq '*'
      || $c eq '"')
    {
      $dst .= sprintf("_%02x", $d);
    }
    else
    {
      $dst .= $c;
    }
  }
  return $dst;
}

sub _local
{
  my $src  = shift;
  my $_src = $src;
  my $dst;

  # depth
  $_src =~ s{^\d+\.}{};

  # type and attr
  $_src =~ s{\.([a-z]+)(\.\w+\.attr)?$}{};
  my @SRC = split(//, $_src);
  for (my $i = 0; $i < scalar(@SRC); $i++)
  {
    if ($SRC[$i] eq '_')
    {
      if ($SRC[$i + 1] eq '_')
      {
        $dst .= '_';
        $i++;
      }
      elsif ($SRC[$i + 1] eq '-')
      {
        $dst .= '.';
        $i++;
      }
      else
      {
        $dst .= chr(hex($SRC[$i + 1] . $SRC[$i + 2]));
        $i += 2;
      }
    }
    elsif ($SRC[$i] eq '.')
    {
      $dst .= '/';
    }
    else
    {
      $dst .= $SRC[$i];
    }
  }

  $dst = Encode::decode("utf8", $dst);
  return $dst;
}

sub _decrypt
{
  my $key = shift;
  return $key->{'value'};
}
